COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00005 ENDMK
C⊗;

ENTRY AVGRED;
BEGIN "AVGRED"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "BUFDEC" SOURCE!FILE;
INTERNAL SIMPLE INTEGER PROCEDURE AVGRED(INTEGER INBUF,FACTOR);
     BEGIN "AVGRED"
     INTEGER ROWNUM,COLNUM,NEWROW,NEWCOL,OUTBUF,ICOL,JCOL,KCOL,
     IROW,JROW,KROW,NEWPT,PTVAL,II,FACTSQ,RSTOP,CSTOP,PTR1,PTR2;
     DEFINE !="COMMENT";

     COMMENT  CALCULATE NEW ROW AND COLUMN SIZE;

     NEWROW←(ROWNUM←ROWS(INBUF))/FACTOR;		! ROWS IN NEW PIX;
     NEWCOL←(COLNUM←COLMS(INBUF))/FACTOR;		! COLMS IN NEW PIX;
     FACTSQ←FACTOR*FACTOR;				! NUMBER POINTS WE AVERAGE;

     COMMENT  CREATE NEW BUFFER;

     GETBUF(NEWROW,NEWCOL,BYTSZ(INBUF),OUTBUF←FNDBUF);

     COMMENT  THIS LOOP DOES IT;

          COMMENT INDEX THROUGH NEW PICTURE;
    FOR IROW←1 STEP 1 UNTIL NEWROW DO 
	BEGIN
	PTR1←OUTPTR(IROW,1,OUTBUF);
	JROW←1+(IROW-1)*FACTOR;			! START ROW OF SUB-MATRIX;
	RSTOP←JROW+FACTOR-1;			! LAST ROW OF SUB-M;
	FOR ICOL←1 STEP 1 UNTIL NEWCOL DO 
	    BEGIN
	    JCOL←1+(ICOL-1)*FACTOR;			! START COL OF SUB-MATRIX IN OLD PIX;
	    NEWPT←0;
	    CSTOP←JCOL+FACTOR-1;

                    COMMENT THIS IS THE ACTUAL AVERAGING LOOP;
	    FOR KROW←JROW STEP 1 UNTIL RSTOP DO 
		    BEGIN
		    PTR2←INPTR(KROW,JCOL,INBUF);
		    FOR KCOL←JCOL STEP 1 UNTIL CSTOP DO 
			 NEWPT←NEWPT+ILDB(PTR2);	! ADD THEM UP;
		    END;
	       NEWPT←NEWPT/FACTSQ;			! GET AVERAGE;
	       IDPB(NEWPT,PTR1);
	       END;
	  ROWCHK(CHKROW,ROWS,IROW,50);
	  END;
     RETURN (OUTBUF);		! OUR RESULT IS THE NEW BUFFER;
     END "AVGRED";
END "AVGRED";